home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 4 NO 10.st / namedrop.arc / NAMEDROP.LST next >
Encoding:
File List  |  1990-01-16  |  8.0 KB  |  260 lines
  1. '
  2. '              Saved as:  NAMEDROP.BAS or NAMEDROP.LST
  3. '
  4. ' -----------------------------------------------------------------------------
  5. '
  6. '                                 NAMEDROPPER
  7. '                                -------------
  8. '                                 version 1.1
  9. '
  10. '
  11. '                       DISK VOLUME LABEL READER/CHANGER
  12. '
  13. '          This program is designed to find the volume label present on a
  14. '          floppy disk and change or delete it as required.  This is not
  15. '          possible under the normal GEM desktop.
  16. '
  17. '          This program will run, ask for the correct drive to access,
  18. '          inform you if the disk in that drive has a Volume label, and
  19. '          enables you to change or delete it.
  20. '
  21. '          The program runs in LOW, MEDIUM, and HIGH resolutions.
  22. '
  23. '
  24. '                (c) Copyright 1990 by Antic Publishing, Inc.
  25. '
  26. '                                Written by
  27. '                         Al Hubbard  Mississauga, ONT
  28. '                              GEnie - A.HUBBARD1
  29. '
  30. '                                    ENJOY
  31. '
  32. ' ------------------------------------------------------------------------------
  33. '
  34. Res%=Xbios(4)                             ! First we check the resolution,
  35. C%=2                                      ! and set up for HIGH resolution,
  36. D%=150
  37. If Res%=0                                 ! but change the variables to enable
  38.   A%=20                                   ! us to print properly on the screen
  39.   B%=160                                  ! if resolution is LOW or MED.
  40.   C%=1
  41.   D%=0
  42. Endif
  43. If Res%=1
  44.   C%=1
  45.   D%=0
  46. Endif
  47. '
  48. Deffill 1,2,8                             ! Draw top title box.
  49. Pbox 154-B%,4,460-B%,20*C%
  50. Pbox 160-B%,0,470-B%,18*C%
  51. Deffill 0,2,8
  52. Pbox 162-B%,1,468-B%,17*C%
  53. Deftext 1,16,0,8*C%
  54. Text 184-B%,13*C%,"N A M E D R O P P E R"
  55. '
  56. Deffill 1,2,8                             ! Draw bottom info box.
  57. Pbox 154-B%,165+D%,460-B%,190+D%
  58. Pbox 160-B%,163+D%,470-B%,188+D%
  59. Deffill 0,2,8
  60. Pbox 162-B%,164+D%,468-B%,187+D%
  61. Deftext 1,0,0,6
  62. Text 176-B%,173+D%,"Modify volume labels w/o re-format"
  63. Text 176-B%,183+D%,"Copyright 1990 by Antic Publishing"
  64. '
  65. Start:
  66. Pbox 160-B%,32*C%,470-B%,88*C%            ! Clear between titles only!
  67. Do
  68.   Dr%=0
  69.   Print At(29-A%,4);"Drive to access (A/B)?     ";
  70.   Repeat
  71.     Dr$=Inkey$                            ! This section selects the drive to
  72.   Until Dr$<>""                           ! access, limiting the selection
  73.   If Dr$="A" Or Dr$="a"                   ! to drive A or B only.
  74.     Dr%=1
  75.   Endif
  76.   If Dr$="B" Or Dr$="b"
  77.     Dr%=2
  78.   Endif
  79.   Exit If Dr%=1 Or Dr%=2
  80. Loop
  81. Print At(52-A%,4);Upper$(Dr$)
  82. Chdrive Dr%                               ! Change drive to desired one.
  83. Chdir "\"                                 ! Change directory to the root.
  84. Buffer$=Space$(44)                        ! Set/clear buffer for disk info.
  85. Void Gemdos(26,L:Varptr(Buffer$))         ! Inform GEMDOS of new DTA buffer.
  86. B$="*.*"                                  ! Declare ANY file for search,
  87. Attr%=8                                   ! with the LABEL attribute.
  88. Void Gemdos(78,L:Varptr(B$),Attr%)        ! Find 1st file fitting above.
  89. Label$=Left$(Right$(Buffer$,14),12)       ! Parse file name only out.
  90. '
  91. If Label$="            "                  ! Indicate if LABEL present
  92.   Print At(22-A%,6);"Disk in DRIVE "+Upper$(Dr$)+" does NOT have a LABEL!"
  93.   Mm$=" Add "
  94. Else
  95.   Print At(26-A%,6);"LABEL for disk in DRIVE ";Upper$(Dr$)+" Is: "
  96.   Print At((40-A%)-(Len(Label$)/2),8);Label$
  97.   Mm$=" Change "
  98. Endif
  99. '
  100. M$="    What would you like     | |   to do with the Label?  "
  101. Alert 2,M$,1," Nothing | Delete |"+Mm$,B
  102. If B=1
  103.   Goto End
  104. Endif
  105. If B=2
  106.   Newlabel$=""
  107. Endif
  108. If B=3
  109.   Print At(21-A%,6);"                                       "
  110.   Print At(24-A%,8);"LABEL desired (11 characters ONLY!)"
  111.   Print At(34-A%,10);
  112.   '
  113.   Gosub Get_input
  114.   '
  115.   If Newlabel$=""
  116.     Print At(24-A%,8);"      New Label NOT selected!       "
  117.     Goto End
  118.   Endif
  119. Endif
  120. Gosub Do_it
  121. '
  122. End:
  123. M$="Would you like to| |quit the program?"
  124. Alert 2,M$,1," No | Yes ",B
  125. If B=2
  126.   Void Gemdos(26,L:Basepage+128)          ! Re-establish normal DTA buffer.
  127.   End
  128. Else
  129.   Goto Start
  130. Endif
  131. '
  132. Procedure Do_it
  133.   If Label$<>"            " Or Newlabel$=""
  134.     Void Gemdos(60,L:Varptr(Label$),0)    ! Open previous LABEL file with
  135.     '                                     ! with normal file attribute set.
  136.     Void Gemdos(62,L:Varptr(Label$))      ! Close this file.
  137.     Void Gemdos(65,L:Varptr(Label$))      ! Delete this file (can be deleted
  138.     '                                     ! because it is now a normal file).
  139.   Endif
  140.   '
  141.   If Newlabel$<>""
  142.     Void Gemdos(60,L:Varptr(Newlabel$),8) ! Open file with new name and
  143.     Void Gemdos(62,L:Varptr(Newlabel$))   ! and then CLOSE the file.
  144.   Endif
  145.   '
  146.   Deffill 0,2,8
  147.   Pbox 160-B%,32*C%,470-B%,88*C%
  148.   If B=2
  149.     Print At(22-A%,6);"Disk in DRIVE "+Upper$(Dr$)+" does NOT have a LABEL!"
  150.   Else
  151.     Print At(26-A%,6);"LABEL for disk in DRIVE ";Upper$(Dr$)+" Is: "
  152.     Print At((40-A%)-(Len(Newlabel$)/2),8);Newlabel$
  153.   Endif
  154. Return
  155. '
  156. Procedure Get_input
  157.   Local Label$,Char$,Test$,Only1%,Xprint%,Yprint%,Y%
  158.   Char$=""
  159.   Label$=""
  160.   Only1%=0
  161.   '
  162.   Xprint%=35-A%                           ! X position for input line
  163.   Yprint%=10                              ! Y position for input line
  164.   Y%=12                                   ! Amount of characters desired
  165.   '
  166.   Test$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_.:#"    ! Allowable characters.
  167.   Print At(Xprint%,Yprint%);"________.___"
  168.   Print At(Xprint%,Yprint%);
  169.   For X%=1 To Y%
  170.     Print At(Xprint%-1+X%,Yprint%);"|";
  171.     Lpoke Xbios(14,1)+6,0                 ! Clears keyboard buffer.
  172.     Char$=""
  173.     Do
  174.       If Inp?(2)                          ! Gets 1 character
  175.         Char$=Chr$(Inp(2))
  176.       Endif
  177.       Exit If Char$<>""
  178.     Loop
  179.     If Char$=Chr$(13)                     ! Stops input when return pressed.
  180.       X%=12
  181.       Char$=""
  182.       Goto Endit
  183.     Endif
  184.     Char$=Upper$(Char$)
  185.     If Instr(Test$,Char$)<>0              ! Tests for allowable characters.
  186.       If Char$="."
  187.         If X%=1                           ! First position only.
  188.           Print At(Xprint%,Yprint%);" ";
  189.         Else
  190.           Print At(Xprint%+X%-1,Yprint%);" ";
  191.         Endif
  192.         If Y%=8
  193.           X%=8
  194.           Goto Endit
  195.         Endif
  196.         If Only1%=0                       ! Allows period (only 1, though)
  197.           Print String$(9-X%," ")
  198.           Only1%=1
  199.           X%=9
  200.           Label$=Label$+Char$             ! Builds string of these characters.
  201.         Else
  202.           Char$=""
  203.           X%=X%-1
  204.         Endif
  205.       Else
  206.         Label$=Label$+Char$
  207.       Endif
  208.       Print At(Xprint%-1+X%,Yprint%);Char$;
  209.     Else
  210.       Dec X%
  211.     Endif
  212.     If Char$=Chr$(8)                      ! Backup cursor.
  213.       Dec X%
  214.       If X%>0                             ! Not first character.
  215.         If X%=8
  216.           If Right$(Label$,1)="."
  217.             Dec X%
  218.           Endif
  219.           If X%>Instr(Label$,".")-1
  220.             X%=Instr(Label$,".")-1
  221.           Endif
  222.           Label$=Left$(Label$,X%)
  223.           Print At(Xprint%,Yprint%);"________.___"
  224.           Print At(Xprint%,Yprint%);Label$
  225.           Only1%=0
  226.         Else
  227.           Label$=Left$(Label$,Len(Label$)-1)
  228.           Print At(Xprint%+X%,Yprint%);" _";
  229.         Endif
  230.         Goto Endit
  231.       Else
  232.         X%=0                              ! Is the first character.
  233.         Label$=""
  234.         Print At(Xprint%+X%,Yprint%);" _";
  235.       Endif
  236.     Endif
  237.     If Len(Label$)=8 Or X%=8
  238.       If Instr(Label$,".")=0
  239.         Inc X%
  240.         Print ".";
  241.         Label$=Label$+"."
  242.         Only1%=1
  243.       Endif
  244.     Endif
  245.     Endit:
  246.   Next X%
  247.   If Right$(Label$,1)="."
  248.     Newlabel$=Left$(Label$,Instr(Label$,".")-1)
  249.   Else
  250.     If Left$(Label$,1)="."
  251.       Newlabel$=Right$(Label$,Len(Label$)-1)
  252.     Else
  253.       Newlabel$=Label$                    ! Returns the filename.
  254.     Endif
  255.   Endif
  256. Return
  257. '
  258. ' ------------------------------------------------------------------------------
  259. '
  260.